home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / mathsolv.arc / ROMBERG.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1987-03-11  |  2.8 KB  |  70 lines
  1. 10  ' Romberg Integration Routine
  2. 20  ' Copyright 1987 - Joseph D. Cusimano, P.O. Box 2622, Norman, OK 73070
  3. 30  ' All Rights Reserved
  4. 40  SCREEN 0,0,0:WIDTH 80:KEY OFF:CLS
  5. 50  ON KEY(1) GOSUB 630:KEY(1) ON
  6. 60  LOCATE 1,24,0:PRINT "Romberg Integration Routine V2.1"
  7. 70  PRINT
  8. 80  PRINT "     Directions:  =====> INSERT FUNCTION TO INTEGRATE AT LINE NUMBER 610 <===="
  9. 90  PRINT "                  ------------------------------------------------------------"
  10. 100  PRINT "                  List lines 605 on and follow directions then run the program."
  11. 110  PRINT "                  You will be prompted for the limits of integration and "
  12. 120  PRINT "                  the convergence criterion.  To quit at any time just press"
  13. 130  PRINT "                  the F1 function key."
  14. 140  PRINT
  15. 150  PRINT "     This utility is provided on an as-is basis only.  This has been released"
  16. 160  PRINT "     for the publics free use, but it IS copyrighted and not to be used for"
  17. 170  PRINT "     profit by anyone without prior permission!  Please leave the copyright "
  18. 180  PRINT "     notice in this source program!  (Your conscience will haunt you forever"
  19. 190  PRINT "     and ever if you don't!)  If you have any suggestions, comments, or "
  20. 200  PRINT "     questions, send them to:"
  21. 210  PRINT "                                Joe Cusimano"
  22. 220  PRINT "                                P.O. Box 2622"
  23. 230  PRINT "                                Norman, OK 73070"
  24. 240  PRINT
  25. 250  PRINT "                  (C) Copyright 1987, Joseph D. Cusimano"
  26. 260  PRINT "                           All Rights Reserved"
  27. 270  PRINT:PRINT "                         Press any key to continue"
  28. 280  FOR X!=1 TO 40:A$=INKEY$:NEXT X!
  29. 290  A$=INKEY$:IF A$="" THEN 290
  30. 300  CLS:CLEAR
  31. 310  ' ====> INSERT FUNCTION TO INTEGRATE INTO LINE 610 <====
  32. 320  DIM T#(50,50)
  33. 330  PRINT:INPUT "What is the limit of integration, A ";A#
  34. 340  PRINT:INPUT "What is the limit of integration, B ";B#
  35. 350  PRINT:INPUT "What is convergence criterion ";ER#
  36. 360  PRINT:PRINT "SOLVING - Be patient, depending on your convergence criterion and the function,"
  37. 365  PRINT "          this can take several minutes.":PRINT:PRINT
  38. 370  X#=A#:GOSUB 610:FA#=FX#:X#=B#:GOSUB 610:FB#=FX#:X#=(A#+B#)/2:GOSUB 610:FAB#=FX#
  39. 380  T#(1,1)=((B#-A#)/2)*(FA#+FB#)
  40. 390  T#(1,2)=(T#(1,1)/2)+((B#-A#)/2)*(FAB#)
  41. 400  T#(2,1)=(1/3)*(4*T#(1,2)-T#(1,1))
  42. 410  J=3
  43. 420  DELX#=(B#-A#)/(2^(J-1))
  44. 430  X#=A#-DELX#
  45. 440  N=2^(J-2)
  46. 450  SUM#=0
  47. 460  I=1
  48. 470  X#=X#+2*DELX#
  49. 480  GOSUB 610
  50. 490  SUM#=SUM#+FX#
  51. 500  IF I<>N THEN I=I+1:GOTO 470
  52. 510  T#(1,J)=(T#(1,J-1)/2)+DELX#*SUM#
  53. 520  L=2
  54. 530  K=J+1-L
  55. 540  T#(L,K)=((4^(L-1))*T#(L-1,K+1)-T#(L-1,K))/(4^(L-1)-1)
  56. 550  IF L<>J THEN L=L+1:GOTO 530
  57. 560  IF ABS(T#(J,1)-T#(J-1,1))>ER# THEN J=J+1:GOTO 420
  58. 570  LL=10
  59. 580  CC=1
  60. 590  PRINT "Numerical Solution = ";T#(J,1)
  61. 600  END
  62. 605  ' Insert Function to integrate in line 610, it MUST be in terms of FX#
  63. 606  ' equals some function of X#!  [The following example is integrating
  64. 607  ' one over x squared: FX#=(1)/(x#^2)]                                       608 '
  65. 608  '
  66. 610  FX#=((1)/(X#^2))
  67. 615  '
  68. 620  RETURN
  69. 630  PRINT:PRINT "ABORT - RETURNING TO BASIC":END
  70.